SuperStrict
NoDebug
    
Rem   
bbdoc: MaxMod.ModPlayer
End Rem
Module MaxMod.ModPlayer
ModuleInfo "MaxMod: ModPlayer 1.25"
ModuleInfo "Author: REDi - Cliff Harman"
ModuleInfo "License: MIT"

Import BRL.EventQueue
Import BRL.Bank
Import BRL.Retro
Import BRL.Math
Import BRL.AudioSample
Import MaxMod.Music

Import "inc/funcs.cpp"
Extern "C"
	Function Interpolate_Cosine:Double(a:Int, b:Int, pos:Double)
	Function CalculatePan(Pan:Double, EnvelopePan:Double, LPanCalc:Double Var, RPanCalc:Double Var)
	Function Convert32BitLRTo16Bit:Int(LBuf32:Byte Ptr, RBuf32:Byte Ptr, Buf16:Byte Ptr, length:Int, vol:Double)
EndExtern

Include "inc/pattern.bmx"
Include "inc/channel.bmx"
Include "inc/instrument.bmx"
Include "inc/sample.bmx"
Include "inc/protracker.bmx"
Include "inc/fasttracker.bmx"
Include "inc/maxtracker.bmx"

Const MM_NONE				:Int = 0
Const MM_LINEAR				:Int = 1
Const MM_CATMULLROM			:Int = 2
Const MM_TEMPO 				:Int = 100
Const MM_SPEED 				:Int = 101
Const MM_INTERPOLATION 		:Int = 102
Const MM_STEREOSEPERATION	:Int = 103
Const MM_GAIN				:Int = 104
Const MM_TRACKER			:Int = 105
Const MM_TITLE				:Int = 106
Const MM_LINE				:Int = 110
Const MM_SEQUENCE			:Int = 111
Const MM_PATTERN			:Int = 112
Const MM_TICK				:Int = 113
Const MM_EMITTICK			:Int = 114
Const MM_SONGNAME			:Int = 115
Const MM_SCOPE				:Int = 116

Const EVENT_MAXMODLINETICK	:Int = 501

Const CMD_ARPPEGIATION						:Int = $0	' 0
Const CMD_PORTAMENTOUP						:Int = $1	' 1
Const CMD_PORTAMENTODOWN					:Int = $2	' 2
Const CMD_PORTAMENTONOTE					:Int = $3	' 3
Const CMD_VIBRATO							:Int = $4	' 4
Const CMD_PORTAMENTONOTE_AND_VOLUMESLIDE	:Int = $5	' 5
Const CMD_VIBRATO_AND_VOLUMESLIDE			:Int = $6	' 6
Const CMD_TREMOLO							:Int = $7	' 7
Const CMD_SETPAN							:Int = $8	' 8
Const CMD_SETSAMPLEOFFSET					:Int = $9	' 9
Const CMD_VOLUMESLIDE						:Int = $A	' A
Const CMD_POSITIONJUMP						:Int = $B	' B
Const CMD_SETVOLUME							:Int = $C	' C
Const CMD_PATTERNBREAK						:Int = $D	' D
Const CMD_EXTENDED							:Int = $E	' E
Const CMD_SETTIMING							:Int = $F	' F
Const CMD_GLOBALVOLUME						:Int = $10	' G
Const CMD_GLOBALVOLUMESLIDE					:Int = $11	' H
Const CMD_SETENVELOPEPOSITION				:Int = $15	' L
Const CMD_PANNINGSLIDE						:Int = $19	' P
Const CMD_MULTIRETRIGNOTE					:Int = $1B	' R
Const CMD_EXTRAFINEPORTAMENTO				:Int = $21	' X

Const CMD_EX_SETFILTER						:Int = $0	' E0 unsupported
Const CMD_EX_FINEPORTAMENTOUP				:Int = $1	' E1
Const CMD_EX_FINEPORTAMENTODOWN				:Int = $2	' E2
Const CMD_EX_GLISSANDOCONTROL				:Int = $3	' E3
Const CMD_EX_VIBRATOCONTROL					:Int = $4	' E4
Const CMD_EX_SETFINETUNE					:Int = $5	' E5
Const CMD_EX_LINELOOP						:Int = $6	' E6
Const CMD_EX_TREMOLOCONTROL					:Int = $7	' E7
Const CMD_EX_SETPAN16						:Int = $8	' E8
Const CMD_EX_RETRIGNOTE						:Int = $9	' E9
Const CMD_EX_FINEVOLUMEUP					:Int = $A	' EA
Const CMD_EX_FINEVOLUMEDOWN					:Int = $B	' EB
Const CMD_EX_NOTECUT						:Int = $C	' EC
Const CMD_EX_DELAYNOTE						:Int = $D	' ED
Const CMD_EX_PATTERNDELAY 					:Int = $E	' EE

' --------------------------------------------------------------------------------------------------

Rem
bbdoc: Provides MOD/XM format support for the BlitzMax LoadSound command.
End Rem
Type TAudioSampleLoaderMOD Extends TAudioSampleLoader
	Method LoadAudioSample:TAudioSample( stream:TStream )
		Local Music:TMusic = MaxMod_Mixer(LoadMusic(Stream))
		If Not music Return Null
		Local Length:Int = Music.Geti(MM_LENGTH)
		Local sample:TAudioSample = CreateAudioSample(length,Music.SAMPLE_RATE,SF_STEREO16LE)
		Music.PlayStatus = 1
		Music.FillBuffer(Int(Sample.Samples),length*4)
		Return Sample
	End Method
End Type
AddAudioSampleLoader New TAudioSampleLoaderMOD

' --------------------------------------------------------------------------------------------------
 
Type MaxMod_Mixer Extends TMusic

	' tracker settings
	Field TrackerName			:String					' stores original trackers name
	Field MaxPatterns			:Int    = 512			' maximum number of patterns
	Field MaxSequences			:Int    = 256			' maximum length of the sequence
	Field MaxInstruments		:Int    = 256			' maximum number of instruments
	Field DefaultTempo			:Int    = 125			' stores the songs default tempo
	Field DefaultSpeed			:Int    = 6				' stores the songs default speed
	Field PeriodMode			:Int    = 1				' 1=Linear 0=Amiga
	Field SongName				:String					' stores the title of the song
'	Field SongVolume			:Double = 1.0			' the songs global volume
	Field ActiveChannels		:Int					' stores the number of tracks per channel
	Field ActiveSequences		:Int 					' the current highest sequence number
	Field ActiveSongPatterns	:Int					' length of the sequence (song)
	Field ActiveSamples			:Int					' number of instruments in use.
	Field SongPattern			:Int[0]					' holds the sequence of patterns
	Field Instrument			:MaxMod_Instrument[0]	' array of instruments
	Field Pattern				:MaxMod_Pattern[0]		' array of patterns
	Field MMC_Channel			:MaxMod_Channel[0]		' the array of channels
	Field CurrentPattern		:Int					' current pattern number
	Field CurrentLine			:Int					' current line number
	Field CurrentSongPattern	:Int					' current sequence number
	Field Tempo					:Int    = 125			' current tempo
	Field Speed					:Int    = 6				' current speed
	Field MMTick				:Int					' current tick
	Field BytesUntilTick		:Int					' number of samples to mix before the next tick
	Field Interpolate			:Int    = 1				' 0 = None, 1 = Linear (default), 2 = Catmull-rom
	Field MixLevel				:Float  = 0.5			' gain used when mixing channels
	Field StereoSeperation		:Float  = 1.0			' 1 = stereo mix, 0 = mono mix
	Field EmitTick				:Int    = False
	Field TickEvent				:TEvent = New TEvent
	Field PatternLock			:Int	= False 		' if true the current pattern will repeat at the end
	Field LineJump				:Int 	= -1
	Field MMJump				:Int 	= -1
	Field MMJumpLine			:Int    = 0
	Field PatternLoopStart		:Int	= 0
	Field PatternLoopEnd		:Int	= 0
	Field PatternLoopCount		:Int 	= -1
	Field patterndelay			:Int	= 0

	Method New()
		SAMPLE_RATE		 		= 44100
		TickEvent.Source 		= Self
		TickEvent.ID     		= EVENT_MAXMODLINETICK
	EndMethod

	Method Init(Channels:Int)
		Instrument				= New MaxMod_Instrument[MaxInstruments]	' array of instruments
		Pattern					= New MaxMod_Pattern[MaxPatterns]		' array of patterns
		SongPattern				= New Int[MaxSequences]					' holds the sequence of patterns	
		MMC_Channel				= New MaxMod_Channel[Channels]			' array of channels
		ActiveChannels			= Channels
		Local chan:Int
		For chan=0 Until Channels
			MMC_Channel[chan]        = New MaxMod_Channel
		Next
	EndMethod
 
	Method Delete()
		If Instrument Free
	EndMethod
	
	Method Free()
		Local n:Int
		For n=0 Until ActiveChannels
			MMC_Channel[n].instrument = Null
			MMC_Channel[n].sample = Null
		Next
		For n=0 Until ActiveSamples
			If instrument[n] Then instrument[n].Sample	= Null
		Next
		Instrument	= Null		
		Pattern		= Null
		SongPattern	= Null
		MMC_Channel	= Null
		TickEvent	= Null
		Super.Free
	EndMethod

	' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	Function Load:MaxMod_Mixer(f:TStream)
		Local chk$ = ReadString(f,3)
		If chk<>"MMM" Return Null
		Local This:MaxMod_Mixer = New MaxMod_Mixer 
		Local i:Int				= ReadByte(f)
		This.TrackerName 		= ReadString(f,i)
		This.MaxPatterns 		= ReadInt(f)
		This.MaxSequences 		= ReadInt(f)	
		This.MaxInstruments 	= ReadInt(f)
		This.DefaultTempo 		= ReadInt(f)
		This.DefaultSpeed 		= ReadInt(f)
		This.PeriodMode 		= ReadInt(f)
		This.Tempo				= ReadInt(f)
		This.Speed				= ReadInt(f)
		This.MixLevel			= ReadFloat(f)
		This.StereoSeperation	= ReadFloat(f)
		i 						= ReadByte(f)
		This.SongName 			= ReadString(f,i)
'		This.SongVolume 		= ReadFloat(f)
		This.ActiveChannels 	= ReadInt(f)
		This.ActiveSequences 	= ReadInt(f)
		This.ActiveSongPatterns = ReadInt(f)
		This.ActiveSamples 		= ReadInt(f)

		This.Init(This.ActiveChannels)

		For i=0 Until This.ActiveSongPatterns; This.SongPattern[i] = ReadInt(f) ; Next

		Local e:Int
		For i=1 To This.ActiveSamples 
			e = ReadByte(f)
			If e This.Instrument[i] = MaxMod_Instrument.Load(f)
		Next

		Local l:Int = ReadInt(f)
		For i=0 Until l
			e = ReadByte(f)	
			If e This.Pattern[i] = MaxMod_Pattern.Load(f)
		Next
		Return This
	
	EndFunction

	' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	Method Save(f:TStream)
		WriteString(f,"MMM")
		Local i:Int
		Local TrackerName$ = "MaxTracker"
		WriteByte f,Len(TrackerName)
		WriteString f,TrackerName
		WriteInt f,MaxPatterns
		WriteInt f,MaxSequences	
		WriteInt f,MaxInstruments
		WriteInt f,DefaultTempo
		WriteInt f,DefaultSpeed
		WriteInt f,PeriodMode
		WriteInt f,Tempo
		WriteInt f,Speed
		WriteFloat f,MixLevel
		WriteFloat f,StereoSeperation
		WriteByte f,Len(SongName)
		WriteString f,SongName
'		WriteFloat f,SongVolume
		WriteInt f,ActiveChannels
		WriteInt f,ActiveSequences
		WriteInt f,ActiveSongPatterns
		WriteInt f,ActiveSamples

		For i=0 Until ActiveSongPatterns ; WriteInt f,SongPattern[i] ; Next

		For i=1 To ActiveSamples
			If Instrument[i]
				WriteByte f,True
				Instrument[i].Save(f)
			Else
				WriteByte f,False
			EndIf
		Next
		
		WriteInt f,Pattern.Length
		For i=0 Until Pattern.Length
			If Pattern[i]
				WriteByte f,True
				Pattern[i].Save(f)
			Else
				WriteByte f,False
			EndIf
		Next
	
	EndMethod

	' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	Field TLAV:Double, TRAV:Double
	Global LAV:Int[44100], RAV:Int[44100]
	Method FillBuffer(SoundData:Int,Length:Int)
		Local frames:Int 				 = Length/GetBytesPerSample(STREAM_FORMAT)
		Local outputBuffer:Short Ptr 	 = Short Ptr(SoundData)

		If PlayStatus=False MemClear(LAV,Length) ; MemClear(RAV,Length) ; Return

		Local Writepos:Int, Writelength:Int, chan:Int
		'TLAV=0 ; TRAV=0
		Repeat  
		     
			If BytesUntilTick=<0 Then Do_Player()
			If BytesUntilTick>(frames-writepos)
				writelength=(frames-writepos)
			Else
				writelength=BytesUntilTick
			EndIf

			MemClear(LAV,4*writelength) ; MemClear(RAV,4*writelength)
			For chan=0 Until ActiveChannels
				MMC_Channel[chan].Mix(LAV,RAV,writelength)
				MMC_Channel[chan].LevelL:*MixLevel
				MMC_Channel[chan].LevelR:*MixLevel
				TLAV:+MMC_Channel[chan].LevelL
				TRAV:+MMC_Channel[chan].LevelR
			Next
			TLAV:/ActiveChannels ; TRAV:/ActiveChannels
			
			Convert32BitLRTo16Bit(LAV, RAV, outputBuffer+(writepos Shl 1), writelength, MixLevel)
			writepos:+writelength
			BytesUntilTick:-writelength
			
		Until writepos=>frames
		STREAM_POS:+frames
	EndMethod

	' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	Method Do_Player()

		Local Chan		:Int
		Local Pat		:MaxMod_Pattern = Pattern[CurrentPattern]
		Local Track		:MaxMod_Track
		If Not pat RuntimeError "no pattern!!!"' ; DebugStop

		For Chan=0 Until ActiveChannels

			Track = Pat.Track[Chan] ; If Not Track Continue
			
			If MMTICK=0 And Track.FX[CurrentLine] 'Or Track.FXV[CurrentLine]>0
				Select Track.FX[CurrentLine]
		            Case CMD_POSITIONJUMP 				; MMJump=Track.FXV[CurrentLine]
		            Case CMD_PATTERNBREAK 				; PatternBreak(Track.FXV[CurrentLine])
		            Case CMD_EXTENDED
		                Select ((Track.FXV[CurrentLine] & %11110000) Shr 4)
		                    Case CMD_EX_LINELOOP 		; PatternLineRepeat((Track.FXV[CurrentLine] & %00001111))
		                    Case CMD_EX_PATTERNDELAY 	; patterndelay=(Track.FXV[CurrentLine] & %00001111)*Speed	' PatternDelay
		               	EndSelect
					Case CMD_SETTIMING 					; SetTiming(Track.FXV[CurrentLine])
					Case CMD_GLOBALVOLUME 				; ' G - Set global volume
					Case CMD_GLOBALVOLUMESLIDE 			; ' H - *Global volume slide
				EndSelect
			EndIf

			MMC_Channel[Chan].ApplyCommand(Track, Self)
			If MMC_Channel[Chan].Add<>0
				MMC_Channel[Chan].PreCalc()
				MMC_Channel[Chan].ApplyKeyOff()
			EndIf
			
		Next 
		
		BytesUntilTick = Floor(SAMPLE_RATE/(Tempo*0.4!))
		
		MMTick:+1
		If MMTick=>Speed 
			If PatternDelay>0
				PatternDelay:-1
			Else
				If EmitTick
					Local TickEvent:TEvent = New TEvent
					TickEvent.ID = EVENT_MAXMODLINETICK
					TickEvent.Data=CurrentLine 
					EmitEvent(TickEvent)
				EndIf
				NEXT_LINE()
				LineJump=-1
				MMTICK=0
			EndIf
		EndIf
		
	EndMethod
	
	
	Method NEXT_LINE()
				
		If LineJump >0 
			If PatternLoopCount>0
				CurrentLine = PatternLoopStart-1
				PatternLoopCount:-1
			EndIf
			LineJump = -1
		EndIf
		
		If LineJump=-1
		    If MMJump=-1
		        CurrentLine:+1
				Local Track:MaxMod_Track = Self.Pattern[CurrentPattern].Track[0]
		        If CurrentLine => Track.LineCount
		        	CurrentLine = 0
					PatternLoopStart = 0
					PatternLoopEnd 	 = 0
					PatternLoopCount = -1
		            If CurrentSongPattern < ActiveSongPatterns
		                SetCurrentSequence(CurrentSongPattern+1)
		                CurrentPattern = SongPattern[CurrentSongPattern]
		            Else
						STREAM_SIZE=STREAM_POS
						STREAM_POS=0
						If STREAM_LOOP = True
			                SetCurrentSequence(0)
			                CurrentPattern = SongPattern[CurrentSongPattern]
'							StartTime = MilliSecs()
						Else
							PlayStatus = False
							Reset
						EndIf
		            EndIf
		        EndIf
		    Else
		        CurrentLine = MMJumpLine ; MMJumpLine = 0
'				If MMJump<CurrentSongPattern Then STREAM_SIZE=STREAM_POS ; STREAM_POS=0
				If MMJump<CurrentSongPattern And STREAM_LOOP = False Then PlayStatus=False ; Reset
		        SetCurrentSequence(MMJump)
				CurrentPattern = SongPattern[CurrentSongPattern]
		        MMJump = -1
				PatternLoopStart = 0
				PatternLoopEnd = 0
				PatternLoopCount:-1
		    EndIf 
		EndIf
		
	EndMethod

	Method PatternBreak(SEQFXV:Int)
		If CurrentSongPattern < ActiveSongPatterns
			MMJump = CurrentSongPattern+1
		Else
			MMJump = 0
		EndIf
		MMJumpLine = SEQFXV
		If MMJumpLine>Pattern[SongPattern[CurrentSongPattern]].LineCount Then MMJumpLine=0
	EndMethod

	Method PatternLineRepeat(RFXV:Int)
		If RFXV = 0
			PatternLoopStart = CurrentLine
		Else
			LineJump = 1
			If PatternLoopCount = -1 And CurrentLine>PatternLoopEnd
				PatternLoopCount = RFXV
				PatternLoopEnd = CurrentLine
			ElseIf PatternLoopCount = 0
				PatternLoopCount = -1
				LineJump = -1
			EndIf
		EndIf
	EndMethod
	
	Method SetTiming(SEQFXV:Int)
		If SEQFXV>0
	       	If SEQFXV =< $1F
				Speed = SEQFXV
			Else
				Tempo = SEQFXV
			EndIf
		EndIf
	EndMethod

	' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	Method Reset()
		Stop
		STREAM_POS			= 0
		MMTICK 				= 0
		CurrentLine 		= 0
        CurrentSongPattern 	= 0
		CurrentPattern		= SongPattern[0]
		Tempo 				= DefaultTempo
		Speed	 			= DefaultSpeed
	EndMethod

    Method SetCurrentSequence(SeqIndex:Int)
		If PatternLock=False
	        CurrentSongPattern 	= SeqIndex
			CurrentPattern 		= SongPattern[SeqIndex]
		EndIf
    EndMethod
	
	Method Stop()
		PlayStatus = 0
		Local chn:Int
		For chn=0 Until ActiveChannels
			MMC_Channel[chn].Instrument = Null
			MMC_Channel[chn].Sample  	= Null
			MMC_Channel[chn].Add 		= 0
			MMC_Channel[chn].Pos 		= 0
		Next
	EndMethod

	Method EnableScopes(Samples:Int)
		Local chn:Int
		For chn=0 Until ActiveChannels
			MMC_Channel[chn].Scope 			= CreateBank(Samples*4)	; MemClear(BankBuf(MMC_Channel[chn].Scope),Samples*4)
			MMC_Channel[chn].ScopePtr 		= Float Ptr(BankBuf(MMC_Channel[chn].Scope))
			MMC_Channel[chn].ScopeFillPos 	= 0
		Next
	EndMethod

	Method UpdateScopes()
		Local chn:Int
		For chn=0 Until ActiveChannels
			MMC_Channel[chn].ScopeFillPos = 0
		Next
	EndMethod

	' - - - - - - - - - - - - - - - - - - - - - - - - - -
	' INFOMATION METHODS	
	Method Seti:Int(Param:Int,value:Int)
		Select Param
			Case MM_TEMPO				; Tempo = value				; Return True
			Case MM_SPEED				; Speed = value				; Return True
			Case MM_INTERPOLATION		; Interpolate = value 		; Return True
			Case MM_EMITTICK			; EmitTick = value			; Return True
			Case MM_SAMPLERATE			; Super.Seti(Param,value)   ; CalcSize ; Return True
			Case MM_SCOPE				; EnableScopes(value)		; Return True
			Case MM_SEQUENCE
				If Value<0 Or Value>ActiveSongPatterns Then Return False
				CurrentSongPattern 	= Value
				CurrentPattern 		= SongPattern[CurrentSongPattern]
				CurrentLine			= 0
				MMTick				= 0
				Local c:Int
				For c=0 Until ActiveChannels
					MMC_Channel[c].Sample = Null
					MMC_Channel[c].Add = Null
				Next
				Return True				
		EndSelect
		Super.Seti(Param,value)
	EndMethod

	Method Geti:Int(Param:Int)
		Select Param
			Case MM_LENGTH	 			; CalcSize ; Return Super.Geti(Param)
			Case MM_TEMPO				; Return Tempo
			Case MM_SPEED				; Return Speed
			Case MM_INTERPOLATION		; Return Interpolate
			Case MM_LINE				; Return CurrentLine
			Case MM_SEQUENCE			; Return CurrentSongPattern
			Case MM_PATTERN				; Return CurrentPattern
			Case MM_TICK				; Return MMTick
			Case MM_EMITTICK			; Return EmitTick
		EndSelect
		Return Super.Geti(Param)
	EndMethod

	Method Setf:Int(Param:Int,value:Float)
		Select Param
			Case MM_STEREOSEPERATION	; StereoSeperation = value	; Return True
			Case MM_GAIN				; MixLevel = value			; Return True
		EndSelect
		Super.Setf(Param,value)
	EndMethod

	Method Getf:Float(Param:Int)
		Select Param
			Case MM_STEREOSEPERATION	; Return StereoSeperation
			Case MM_GAIN				; Return MixLevel
		EndSelect
		Return Super.Getf(Param)
	EndMethod
	
	Method Gets:String(Param:Int)
		Select Param
			Case MM_SONGNAME			; Return SongName
		EndSelect
		Return Super.Gets(Param)
	EndMethod

	' ------------------------------------------------------------------------------------------------

	Method CalcSize()
		Local tlength:Int
		PlayStatus  = True
		STREAM_LOOP = False
		Repeat
			Do_Player()
			If PlayStatus= False Then Exit
			tlength:+BytesUntilTick
		Forever
		STREAM_SIZE = tlength
		Reset
	EndMethod

EndType